home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / BBS_UTL / PROK344 / PROKIT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-10-19  |  8KB  |  271 lines
  1.  
  2. (*
  3.  * Copyright 1987, 1991 Samuel H. Smith;  All rights reserved
  4.  *
  5.  * This is a component of the ProDoor System.
  6.  * Do not distribute modified versions without my permission.
  7.  * Do not remove or alter this notice or any other copyright notice.
  8.  * If you use this in your own program you must distribute source code.
  9.  * Do not use any of this in a commercial product.
  10.  *
  11.  *)
  12.  
  13. (*
  14.  * ProKit.PAS - demo program for the ProKit system (3-1-89)
  15.  *
  16.  *)
  17.  
  18. {!!!IMPORTANT!!! F5 WON'T WORK WITHOUT THE FOLLOWING LINE}
  19. {$M 9000,22000,22000}  {Stack, minheap, maxheap}
  20. {$S-,R-}
  21. {$L+,D+}
  22.  
  23.  
  24. Program ProKit_demo;
  25.  
  26. {$i prokit.inc}    {include standard 'uses' statement}
  27.  
  28.  
  29. (* ---------------------------------------------------------------- *)
  30. procedure display_info;
  31. begin
  32.    Pdispln('$WHITE$');
  33.    pdispln(first_name+', here is your User information:$GREEN$');
  34.    displn('   Current date   = '+system_date+' '+system_time);
  35.    displn('   Full name      = '+username);
  36.    displn('   Phone numbers  = '+user.busphone + ' / ' + user.phone);
  37.    displn('   City           = '+user.city);
  38.    displn('   Security level = '+itoa(userlevel));
  39.    displn('   Baud rate      = '+baudrate);
  40.  
  41.    displn('   Last call date = '+user.date+' '+user.time+
  42.            ', Used = '+itoa(user.lastused)+
  43.            '/'+itoa(pcbsys.prev_used));
  44.  
  45.    displn('   Conference     = '+conf_info.conf_name+' ('+
  46.                   itoa(pcbsys.curconf)+'/'+
  47.                   itoa(user.curconf)+'/'+
  48.                   itoa(current_conf)+')');
  49.  
  50.    displn('   TimeOn (mins)  = '+itoa(pcbsys.time_on)+
  51.            ', Now = '+itoa(get_mins));
  52.  
  53.    displn('   Minutes left   = '+itoa(minutes_left)+
  54.            ', Used = '+itoa(time_used)+
  55.            ', Last = '+itoa(user.lastused)+
  56.            ', Credit = '+itoa(pcbsys.time_credit)+
  57.            ', Limit = '+itoa(pcbsys.time_limit)+
  58.            ', Added = '+itoa(pcbsys.time_added));
  59.  
  60.    displn('   Event schedule = '+itoa(minutes_before_event)+' minutes');
  61.  
  62.    displn('   Downloads      = '+itoa(user.downloads)+
  63.             ', Total = '+dtok(user.downtotal)+
  64.             ', Today = '+dtok(user.downbytes)+
  65.             ', Allowed = '+wtoa(download_k_allowed)+'k');
  66.  
  67.    displn('   Uploads        = '+itoa(user.uploads)+
  68.             ', Total = '+dtok(user.uptotal)+
  69.             ', Earned = '+wtoa(user.earned_k));
  70.  
  71.    disp  ('   Expert mode    = ');
  72.    if expert then displn('ON') else displn('OFF');
  73.  
  74.    disp  ('   Graphics       = ');
  75.    if graphics then displn('ON') else displn('OFF');
  76.  
  77.    displn('   Packed flags   = '+itoa(user.pcbflags));
  78.    displn('   User.inf ptr   = '+ltoa(user.userinf_ptr));
  79.    displn('   Curconfh       = '+wtoa(user.curconfh));
  80.  
  81.    force_enter;
  82. end;
  83.  
  84.  
  85.  
  86. (* ---------------------------------------------------------------- *)
  87. procedure take_chance;
  88. var
  89.    thinking_of:  anystring;
  90.  
  91. begin
  92.    {think of a number - based on the time of day}
  93.    thinking_of := itoa(random(9));
  94.  
  95.    {check for a stacked response- prompt if not}
  96.    if length(cmdline) = 0 then
  97.    begin
  98.       pdispln('$CYAN$I''m thinking of a number from 0 to 9.   If you guess the');
  99.       displn('number, you will be given an extra 10 minutes online.  If you');
  100.       displn('get it wrong, your time will be reduced by 2 minutes.');
  101.       newline;
  102.       pdisp('$YELLOW$What''s your guess? ');
  103.       get_cmdline;
  104.       newline;
  105.    end;
  106.  
  107.    {get the input and process it}
  108.    get_nextpar;
  109.    if par = thinking_of then
  110.    begin
  111.       pdispln('$GREEN$That''s right!  You get a 10 minute bonus!');
  112.       adjust_time_allowed(10 * 60);
  113.    end
  114.    else
  115.  
  116.    begin
  117.       pdispln('$BLUE$Wrong!  You lose 2 minutes!  I was thinking of '+thinking_of+'.');
  118.       adjust_time_allowed(-120);
  119.    end;
  120.  
  121. end;
  122.  
  123.  
  124.  
  125. (* ---------------------------------------------------------------- *)
  126. procedure test_pattern;
  127. var
  128.    i:     integer;
  129.    start: longint;
  130.  
  131. begin
  132.    flush_com;
  133.    start := lget_ms;
  134.    for i := 1 to 40 do
  135.       displn('(1234567890-abcdefghijklmnopqrstuvwxyz-ABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789)');
  136.    flush_com;
  137.    displn('Speed = '+ftoa(3160000.0 / int(lget_ms - start),0,1)+' char/sec');
  138. end;
  139.  
  140.  
  141. (* ---------------------------------------------------------------- *)
  142. procedure ansi_demo;
  143. var
  144.    x,y: integer;
  145.  
  146. begin
  147.    if not graphics then
  148.    begin
  149.       displn('You must be in GRAPHICS mode to run this demo.');
  150.       displn('Use the (M) command from the main board.');
  151.       exit;
  152.    end;
  153.  
  154.    pdisp('$GREEN$');
  155.    clear_screen;
  156.  
  157.    for y := 2 to 21 do
  158.    begin
  159.       position(1,y);  dispc('│');
  160.       position(79,y); dispc('│');
  161.    end;
  162.  
  163.    position(2,1);
  164.    for x := 2 to 78 do
  165.       dispc('─');
  166.  
  167.    position(2,22);
  168.    for x := 2 to 78 do
  169.       dispc('─');
  170.  
  171.    position(1,1);   dispc('┌');
  172.    position(79,1);  dispc('┐');
  173.    position(1,22);  dispc('└');
  174.    position(79,22); dispc('┘');
  175.  
  176.    position(30,10);  pdisp('$RED$ P r o   K i t ');
  177.    position(12,12);  pdisp('$YELLOW$ This is only a SMALL sample of what ProKit can do! ');
  178.    position(30,18);  pdisp('$WHITE$Press (Enter): ');
  179.    get_cmdline;
  180.  
  181.    cmdline := '';
  182.    clear_screen;
  183. end;
  184.  
  185.  
  186. (* ---------------------------------------------------------------- *)
  187. procedure menu;
  188. begin
  189.    newline;
  190.    pdispln('$GRAY$ProKit DEMO - Based on ProKit '+version);
  191.    newline;
  192.  
  193.    display_file('prokit.m');  {uses prokit.mg in graphics mode}
  194.    force_enter;
  195.    newline;
  196.  
  197.    {main command loop}
  198.    repeat
  199.  
  200.       {prompt for input only if there is not a stacked command pending}
  201.       if length(cmdline) = 0 then
  202.       begin
  203.          newline;
  204.          pdispln('$WHITE$'+  'Main menu:');
  205.          pdispln('$RED$'+    ' (I)  Display system information');
  206.          pdispln('$GREEN$'+  ' (C)  Take a chance for more time online');
  207.          pdispln('$MAGENTA$'+' (T)  Display a test pattern, calculate speed');
  208.          pdispln('$CYAN$'+   ' (A)  Ansi graphics demo');
  209.          pdispln('$RED$' +   ' (G)  Goodbye, hang up');
  210.          pdispln('$BLUE$'+   ' (Q)  Return to PCBoard');
  211.          newline;
  212.  
  213.          repeat
  214.             display_time_left;
  215.             pdisp('$YELLOW$Command? ');
  216.             get_cmdline;              {get cmdline, map to upper case}
  217.             newline;
  218.          until dump_user or (length(cmdline) > 0);
  219.       end;
  220.  
  221.       if dump_user then exit;   {leave menu if carrier lost}
  222.       get_nextpar;              {scan next parameter from cmdline into par}
  223.  
  224.       {process commands}
  225.       case par[1] of
  226.          'I':   display_info;
  227.          'C':   take_chance;
  228.          'T':   test_pattern;
  229.          'A':   ansi_demo;
  230.  
  231.          'G':   begin
  232.                    dump_user := true;
  233.                    option := o_logoff;
  234.                 end;
  235.  
  236.          'Q':   exit;
  237.  
  238.          else   pdispln('$MAGENTA$('+par+') is not allowed!  Try again:');
  239.       end;
  240.  
  241.    until dump_user;
  242.  
  243. end;
  244.  
  245.  
  246. (* ---------------------------------------------------------------- *)
  247.  
  248. begin  {main block}
  249.    init;     {must be first - opens com port, loads setup and user data}
  250.    progname := 'Demo';        {program name on status line}
  251.  
  252.    (* the next 4 statements are optional.  If included, they will
  253.       enlarge your EXE file by about 10K, but they will enable access to
  254.       the CONFINFO file as well as to the caller_count function and
  255.       @NUMCALLS@ macro. *)
  256.  
  257.    load_cnames_file;          {locate or create CONFINFO file}
  258.  
  259.    load_conf(0);              {locate main message file, enables @NUMCALLS@}
  260.    mainfn := conf_info.conf_msgfile;
  261.  
  262.    load_conf(current_conf);   {load current conference into conf_info}
  263.  
  264.    (* perform door functions *)
  265.    display_info;
  266.    menu;                      {insert your code here}
  267.  
  268.    uninit;   {must be last - closes com port and updates database}
  269. end.
  270.  
  271.